VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFileEx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private crc As New cCRC32, crcv As Long

Private ifs() As String
Private ifc As Long, ifsz As Long

Private ofs As String
Private ofc As Long

Private spl As Boolean

Public Property Get SplitFile() As Boolean
SplitFile = spl
End Property

Public Property Let SplitFile(ByVal b As Boolean)
spl = b
End Property

Public Property Get CRCResult() As Long
CRCResult = crcv
End Property

Public Property Get InputFileSize() As Long
InputFileSize = ifsz
End Property

Public Property Get InputFileCount() As Long
InputFileCount = ifc
End Property

Public Property Get InputFiles(ByVal Index As Long) As String
InputFiles = ifs(Index)
End Property

Public Property Let InputFiles(ByVal Index As Long, ByVal s As String)
ifs(Index) = s
End Property

Public Property Get OutputFile() As String
OutputFile = ofs
End Property

Public Property Let OutputFile(ByVal s As String)
ofs = s
End Property

Public Property Get OutputFileCount() As Long
OutputFileCount = ofc
End Property

Public Sub Add(ByVal s As String, Optional ByVal Index As Long)
Dim i As Long
If Index = 0 Then
 ifc = ifc + 1
 ReDim Preserve ifs(1 To ifc)
 ifs(ifc) = s
Else
 ifc = ifc + 1
 ReDim Preserve ifs(1 To ifc)
 For i = ifc To Index + 1 Step -1
  ifs(i) = ifs(i - 1)
 Next i
 ifs(Index) = s
End If
End Sub

Public Sub Remove(ByVal Index As Long)
Dim i As Long
If ifc <= 1 Then
 ifc = 0
 Erase ifs
Else
 For i = Index To ifc - 1
  ifs(i) = ifs(i + 1)
 Next i
 ifc = ifc - 1
 ReDim Preserve ifs(1 To ifc)
End If
End Sub

Public Sub Clear()
ifc = 0
Erase ifs
End Sub

Public Sub MakeMPQEx()
Dim i As Long, j As Long, m As Long, l As Long
Dim d() As Byte, d2() As Byte
'get size
For i = 1 To ifc
 m = m + FileLen(ifs(i))
Next i
ifsz = m
'copy data
ReDim d(m - 1)
j = 0
For i = 1 To ifc
 l = FileLen(ifs(i))
 If l > 0 Then
  ReDim d2(1 To l)
  Open ifs(i) For Binary As #1
  Get #1, 1, d2
  Close 1
  CopyMemory d(j), d2(1), l
  j = j + l
 End If
Next i
'crc
crcv = crc.GetByteArrayCrc32(d)
'compress
CompressByteArray d, 9 '9? danger!!!
m = ValueCompressedSize
'write MPQ
i = 1
j = 0
Do Until m < 666666 Or Not spl
 ReDim d2(1 To 512000)
 CopyMemory d2(1), d(j), 512000
 PutMPQEx CStr(App.Path) + "\Upload\" + ofs + CStr(i) + ".mpq", d2
 j = j + 512000
 m = m - 512000
 i = i + 1
Loop
ReDim d2(1 To m)
CopyMemory d2(1), d(j), m
PutMPQEx CStr(App.Path) + "\Upload\" + ofs + CStr(i) + ".mpq", d2
ofc = i
End Sub

Public Sub PutMPQEx(ByVal fn As String, b() As Byte)
Dim s As String * 3
Dim l As Long
Open fn For Output As #1
Close 1
Open fn For Binary As #1
s = "MPQ"
Put #1, 1, s
l = UBound(b)
Put #1, 4, l
Put #1, 8, b
Close 1
End Sub

Private Sub Class_Initialize()
crc.Value = &HDEADBEEF
spl = True
End Sub

